home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 February / EnigmA AMIGA RUN 15 (1997)(G.R. Edizioni)(IT)[!][issue 1997-02][PLANET CD V].iso / progs / thor / headermanager.thor < prev    next >
Text File  |  1996-11-10  |  12KB  |  377 lines
  1. /* HeaderManager.thor - (c) Neil Bothwick 1996          */
  2. /* $VER: HeaderManager.thor 1.10 (14.08.96)             */
  3. /* Adds, edits and deletes header lines in Thor events  */
  4.  
  5. /* Thanks to ForwardMsg.thor by Petter Nilsen for some  */
  6. /* of the user database code                            */
  7.  
  8. options results
  9.  
  10. /* needs THOR and bbsread.library functions */
  11. thorport = address()
  12. if left(thorport,5) ~= 'THOR.' then do
  13.     say 'Headers.thor must be run from within Thor.'
  14.     end
  15.  
  16. if ~show('p', 'BBSREAD') then do
  17.     address command
  18.     'run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead'
  19.     'WaitForPort BBSREAD'
  20.     end
  21.  
  22. /* Set up some stuff */
  23. Changed = 0
  24. drop Menu. HdrMenu.
  25. Menu.1 = '""'
  26. Menu.2 = '"Add new header"'
  27. Menu.3 = '""'
  28. Menu.4 = '"Save and exit"'
  29. Menu.5 = '""'
  30. Menu.6 = '"HELP"'
  31. Menu.Count = 6
  32. HdrMenu.1 = 'Cc:'
  33. HdrMenu.2 = 'Bcc:'
  34. HdrMenu.3 = 'Followup-To:'
  35. HdrMenu.4 = 'Reply-To:'
  36. HdrMenu.5 = 'Custom'
  37. HdrMenu.Count = 5
  38. ThorPath = pragma('D')
  39.  
  40. /* Read system details */
  41. address(thorport)
  42. drop GLOBALCFG. CURRENT. BBS.
  43. GETGLOBALCONFIG stem GLOBALCFG
  44. CURRENTSYSTEM stem CURRENT
  45. System = CURRENT.BBSNAME
  46.  
  47. address(bbsread)
  48. GETBBSDATA bbsname '"'System'"' stem BBS
  49. MailAddr = BBS.EMAILADDR
  50. DataPath = BBS.BBSPATH
  51.  
  52. /* Get number of selected event */
  53. address(thorport)
  54. GETSELECTEDEVENT
  55. if(rc ~= 0) then do
  56.     address(thorport)
  57.     errstring = THOR.LASTERROR
  58.     if RC = 5 then errstring = 'Event window not open'
  59.     call ExitMsg(errstring)
  60.     end
  61. EventNo = result
  62.  
  63. /* Get event details */
  64. address(bbsread)
  65. READBREVENT '"'System'"' eventnr EventNo datastem EVENTDATA tagsstem EVENTTAGS
  66. if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  67. if EVENTDATA.EVENTTYPE > 1 then call ExitMsg('You can only edit the headers\nfor an Enter or Reply event')
  68. MsgFile = DataPath||EVENTTAGS.MSGFILE
  69. if pos('.',EVENTTAGS.CONFERENCE) > 0 then IsNews = 1
  70. else IsNews = 0
  71.  
  72. /* Main loop */
  73. call ReadHeaders
  74. do until StopEdit = 1
  75.     StopEdit = MainMenu()
  76.     end
  77.  
  78. address(thorport)
  79. if Changed = 1 then REQUESTNOTIFY '"You have changed some headers.\nDo you want to save them before exiting?"' '"_Yes|_No"'
  80. if RC = 30 then call ExitMsg(THOR.LASTERROR)
  81. if result = 1 then call WriteHeaders
  82.  
  83.  
  84. exit
  85.  
  86. /* Show messages to user */
  87. ShowMsg:
  88.     OldAddr = address()
  89.     address(thorport)
  90.     parse arg MsgStr
  91.     REQUESTNOTIFY '"'MsgStr'"' '" OK "'
  92.     address(OldAddr)
  93.     return
  94.  
  95. ExitMsg:
  96.     parse arg errmsg
  97.     call ShowMsg(errmsg)
  98.     exit
  99.  
  100. /* Show main menu */
  101. MainMenu:
  102.     address(thorport)
  103.     do i = 1 to Menu.Count
  104.         interpret 'Header.'NowHeaders+i '=' Menu.i
  105.         end
  106.     Header.Count = NowHeaders + Menu.Count
  107.  
  108.     REQUESTLIST instem Header SIZEGADGET title '"Headers in current message"'
  109.     if RC = 30 then call ExitMsg(THOR.LASTERROR)
  110.     option = result
  111.     if RC = 5 then return 1
  112.     select
  113.         when option = '' then nop
  114.         when option = 'Add new header' then call AddHeader
  115.         when option = 'Save and exit' then do
  116.             call WriteHeaders
  117.             return 1
  118.             end
  119.         when option = 'HELP' then do
  120.             address command 'MultiView docs/HeaderManager.guide PUBSCREEN' GLOBALCFG.PUBSCREENNAME
  121.             end
  122.         otherwise do
  123.             /* Get number of header selected */
  124.             HdrNo = 0
  125.             do i = 1 to NowHeaders
  126.                 if Header.i = option then HdrNo = i
  127.                 end
  128.  
  129.             REQUESTNOTIFY '"'option'\n\nEdit or Delete this header?"' '"_Edit|_Delete"'
  130.             if RC > 0 then ExitMsg(THOR.LASTERROR)
  131.             if result = 1 then call EditHeader
  132.             else call DeleteHeader
  133.             end
  134.         end
  135.     return 0
  136.  
  137. /* Read headers in current event */
  138. ReadHeaders:
  139.     address(thorport)
  140.     if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
  141.     n = 0
  142.     drop Header.
  143.     Header.Count = 0
  144.     do until eof(msg)
  145.         NextLine = readln(msg)
  146.         if length(NextLine)=0 | right(word(NextLine,1),1) ~= ':' then leave
  147.         n = n + 1
  148.         Header.n = NextLine
  149.         Header.Count = n
  150.         end
  151.     call close(msg)
  152.     MsgHeaders = Header.Count
  153.     NowHeaders = Header.Count
  154.     return
  155.  
  156. /* Update message file with new headers */
  157. WriteHeaders:
  158.     address(thorport)
  159.     OutFile = 'T:ThorHeaders.'time(s)
  160.     if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
  161.     if ~open(out,OutFile,'W') then call ExitMsg('Failed to open temporary file')
  162.     do i = 1 to MsgHeaders
  163.         call readln(msg)
  164.         end
  165.     do i = 1 to NowHeaders
  166.         call writeln(out,Header.i)
  167.         end
  168.     if MsgHeaders = 0 & NowHeaders > 0 then call writeln(out,'')
  169.     do until eof(msg)
  170.         block = readch(msg, 1048576)
  171.         call writech(out,block)
  172.         end
  173.     call close(out)
  174.     call close(msg)
  175.     address command 'copy' OutFile MsgFile
  176.     address command 'delete >NIL:' OutFile
  177.     Changed = 0
  178.     return
  179.  
  180. /* Add a new header */
  181. AddHeader:
  182.     REQUESTLIST instem HdrMenu SIZEGADGET title '"Choose header to add"'
  183.     if RC = 30 then call ExitMsg(THOR.LASTERROR)
  184.     if RC = 5 then return
  185.     Hdr = result
  186.     select
  187.         when Hdr = 'Cc:' then do
  188.             if IsNews = 0 then call GetAddress
  189.             else do
  190.                 call ShowMsg('Cc: headers not allowed in news')
  191.                 Hdr = ''
  192.                 end
  193.             end
  194.         when Hdr = 'Bcc:' then do
  195.             if IsNews = 0 then call GetAddress
  196.             else do
  197.                 call ShowMsg('Bcc: headers not allowed in news')
  198.                 Hdr = ''
  199.                 end
  200.             end
  201.         when Hdr = 'Followup-To:' then do
  202.             if IsNews = 1 then call GetConf
  203.             else do
  204.                 call ShowMsg('Followup-To: headers not allowed in mail')
  205.                 Hdr = ''
  206.                 end
  207.             end
  208.         when Hdr = 'Reply-To:' then do
  209.             call GetAddress
  210.             end
  211.         when Hdr = 'Custom' then do
  212.             REQUESTSTRING title '"Add header"' body '"Enter custom header"' bt '" OK |Cancel"' id '"X-"'
  213.             if RC = 0 then Hdr = result
  214.             else Hdr = ''
  215.             end
  216.         otherwise nop
  217.         end
  218.     if Hdr > '' then do
  219.         NowHeaders = NowHeaders + 1
  220.         Header.Count = NowHeaders
  221.         Header.NowHeaders = Hdr
  222.         Changed = 1
  223.         end
  224.     return
  225.  
  226. /* Edit a header */
  227. EditHeader:
  228.     HdrType = upper(word(Header.HdrNo,1))
  229.     Hdr = ''
  230.     select
  231.         when HdrType = 'CC:' then do
  232.             Hdr = 'Cc:'
  233.             call GetAddress(subword(Header.HdrNo,2))
  234.             end
  235.         when HdrType = 'BCC:' then do
  236.             Hdr = 'Bcc:'
  237.             call GetAddress(subword(Header.HdrNo,2))
  238.             end
  239.         when HdrType = 'FOLLOWUP-TO:' then do
  240.             Hdr = 'Followup-To:'
  241.             call GetConf(subword(Header.HdrNo,2))
  242.             end
  243.         when HdrType = 'REPLY-TO:' then do
  244.             Hdr = 'Reply-To:'
  245.             call GetAddress(subword(Header.HdrNo,2))
  246.             end
  247.         otherwise do
  248.             REQUESTSTRING title '"Edit header"' body '"Editing 'Header.HdrNo'"' bt '" OK |Cancel"' id '"'Header.HdrNo'"'
  249.             if RC = 0 then Hdr = result
  250.             end
  251.         end
  252.  
  253.     if Hdr ~= '' then do
  254.         Header.HdrNo = Hdr
  255.         Changed = 1
  256.         end
  257.  
  258.     return
  259.  
  260. /* Delete a header */
  261. DeleteHeader:
  262.     do i = HdrNo to NowHeaders-1
  263.         interpret 'Header.i = Header.'i+1
  264.         end
  265.     NowHeaders = NowHeaders - 1
  266.     Changed = 1
  267.     return
  268.  
  269. /* Ask for an email address */
  270. GetAddress:
  271.     parse arg default
  272.     if default > '' then OldHdr = Hdr default                   /* Backup original header */
  273.     else OldHdr = ''
  274.  
  275.     REQUESTSTRING title '"Address header"' body '"Enter email address(es)"' bt '" _OK |_Cancel"' id '"'default'"' maxchars 200
  276.     if RC = 30 then ExitMsg(THOR.LASTERROR)
  277.     if RC = 5 then do                                           /* If nothing entered */
  278.         Hdr = OldHdr
  279.         return
  280.         end
  281.     UserName = result
  282.     UserAddr = ''
  283.     drop USERS. SUG.
  284.     address(bbsread)
  285.     SEARCHBRUSER bbsname '"'System'"' stem USERS search '"'UserName'"' name address alias suggestusersstem SUG
  286.     if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
  287.     Found = result
  288.     if Found > 0 then do                                        /* Match(es) found */
  289.         drop LIST.
  290.         drop USERTAGS.
  291.         LIST.COUNT = USERS.COUNT
  292.  
  293.         do i = 1 to USERS.COUNT                                 /* Build a list of user names */
  294.             LIST.i.USERNR = USERS.i.USERNR
  295.             READBRUSER bbsname '"'System'"' usernr USERS.i.USERNR tagsstem USERTAGS
  296.             if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  297.             LIST.i = USERTAGS.NAME
  298.             if(symbol("USERTAGS.ADDRESS") = "VAR") then LIST.i.ADDRESS = USERTAGS.ADDRESS
  299.             end
  300.  
  301.         address(thorport)                                       /* Select a user */
  302.         drop UserName.
  303.         REQUESTLIST instem LIST outstem USERS title '"Select user:"' dragselect
  304.         if RC = 30 then call ExitMsg(THOR.LASTERROR)
  305.  
  306.         do j = 1 to USERS.COUNT
  307.             do i = 1 to LIST.COUNT                              /* Check for email addresses */
  308.                 if LIST.i = USERS.j then UserAddr = UserAddr','LIST.i.ADDRESS
  309.                 end
  310.             end
  311.  
  312.         end
  313.  
  314.     else do                                                     /* No exact match found */
  315.         if(symbol("SUG.COUNT") = "VAR") then do
  316.             address(thorport)
  317.             drop USERS. UserNum.
  318.             REQUESTLIST instem SUG outstem USERS title '"Select user:"' dragselect
  319.             if RC = 30 then call ExitMsg(THOR.LASTERROR)
  320.             if RC = 5 then do                                   /* If cancelled, use address as typed */
  321.                 Hdr = Hdr UserName
  322.                 return
  323.                 end
  324.             do j = 1 to USERS.COUNT
  325.                 do i = 1 to SUG.COUNT                           /* Get the user number */
  326.                     if SUG.i = USERS.j then UserNum.j = SUG.i.USERNR
  327.                     end
  328.                 end
  329.  
  330.             address(bbsread)                                    /* Get data on users selected */
  331.             do i = 1 to USERS.COUNT
  332.                 drop USERTAGS.
  333.                 READBRUSER bbsname '"'System'"' usernr UserNum.i tagsstem USERTAGS
  334.                 if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  335.                 if(symbol("USERTAGS.ADDRESS") = "VAR") then UserAddr = UserAddr','USERTAGS.ADDRESS
  336.                 end
  337.             end
  338.  
  339.         else do                                                 /* No users found in search */
  340.             call ShowMsg('No matching users found')
  341.             UserAddr = ''
  342.             Hdr = OldHdr
  343.             end
  344.         end
  345.  
  346. if left(UserAddr,1) = ',' then UserAddr = substr(UserAddr,2)
  347. if UserAddr > '' then Hdr = Hdr UserAddr
  348. else Hdr = ''
  349. return
  350.  
  351. /* Ask for a conference name */
  352. GetConf:
  353.     parse arg default
  354.     if default > '' then OldHdr = Hdr default                      /* Backup original header */
  355.     else OldHdr = ''
  356.  
  357.     address(bbsread)
  358.     drop CONFS. SELECTED.
  359.     GETCONFLIST bbsname '"'System'"' stem CONFS
  360.     if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
  361.     address(thorport)
  362.     REQUESTLIST instem CONFS outstem SELECTED title '"Select newsgroup(s)"' dragselect
  363.     select
  364.         when RC = 30 then call ExitMsg(THOR.LASTERROR)
  365.         when RC = 5 then Hdr = OldHdr
  366.         otherwise do
  367.             Conf = ''
  368.             do i = 1 to SELECTED.COUNT
  369.                 if upper(SELECTED.i) = 'EMAIL' then SELECTED.i = 'poster'
  370.                 Conf = Conf','SELECTED.i
  371.                 end
  372.             Hdr = Hdr substr(Conf,2)
  373.             end
  374.         end
  375.     return
  376.  
  377.